VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsSendIntIndex"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Function InsertIntoInterfaceIndex(ByRef lngNewIntNo As String, ByVal nNewMessageID As String) As Boolean

'Db vars

Dim adoConn As ADODB.Connection
Dim strSql As String
Dim cmdAdo As ADODB.Command
Dim lngRecordsAffected As Long
Dim rsIndex As ADODB.Recordset



On Error GoTo PROC_ERROR

strSql = "Insert into DIR_INTERFACE_INDEX"
strSql = strSql & " ("
strSql = strSql & " COM_ID,"
strSql = strSql & " BU_ID,"
strSql = strSql & " MESSAGE_ID,"
If nReferenceId <> "NULL" Then
    If nReferenceId <> "" Then
        strSql = strSql & " REFERENCE_ID,"
    End If
End If
If nReqSeqNum <> "NULL" Then
    If nReqSeqNum <> "" Then
        strSql = strSql & " REQ_SEQ_NUM,"
    End If
End If
strSql = strSql & " CREATED_DATE,"
If SarsResponseYn <> "NULL" Then
    If SarsResponseYn <> "" Then
        strSql = strSql & " SARS_RESPONSE_YN,"
    End If
End If
If nTypeResponse <> "NULL" Then
    If nTypeResponse <> "" Then
        strSql = strSql & " KEYTAX_TYPE,"
    End If
End If
strSql = strSql & " MQ_STATUS)"
strSql = strSql & " Values("
strSql = strSql & "'" & nComId & "',"
strSql = strSql & "'" & nBuId & "',"
strSql = strSql & "'" & nNewMessageID & "',"
If nReferenceId <> "NULL" Then
    If nReferenceId <> "" Then
        strSql = strSql & "'" & nReferenceId & "',"
    End If
End If
If nReqSeqNum <> "NULL" Then
    If nReqSeqNum <> "" Then
        strSql = strSql & nReqSeqNum & ","
    End If
End If
strSql = strSql & "GETDATE(),"
If SarsResponseYn <> "NULL" Then
    If SarsResponseYn <> "" Then
        strSql = strSql & "'" & SarsResponseYn & "',"
    End If
End If
If nTypeResponse <> "NULL" Then
    If nTypeResponse <> "" Then
        strSql = strSql & "'" & nTypeResponse & "',"
    End If
End If
strSql = strSql & "'00')"

Set adoConn = New ADODB.Connection
With adoConn
    .ConnectionString = GetConnectionString() 'Johann (20090625): Centralised code for connection string added
    .Open
End With

Set cmdAdo = New ADODB.Command
With cmdAdo
    .CommandText = strSql
    .CommandType = adCmdText
    Set .ActiveConnection = adoConn
    .Execute lngRecordsAffected
End With

If lngRecordsAffected = 1 Then
    'get new interface no
    strSql = "Select INTERFACE_NO from DIR_INTERFACE_INDEX where MESSAGE_ID = '" & nNewMessageID & "'"
    Set rsIndex = adoConn.Execute(strSql)
    If Not rsIndex.EOF Then
        lngNewIntNo = rsIndex!INTERFACE_NO
        InsertIntoInterfaceIndex = True
    Else
        InsertIntoInterfaceIndex = False
    End If
Else
    InsertIntoInterfaceIndex = False
End If

'clean up
rsIndex.Close
Set rsIndex = Nothing
adoConn.Close
Set adoConn = Nothing
Set cmdAdo = Nothing


PROC_EXIT:
  Exit Function

PROC_ERROR:
    InsertIntoInterfaceIndex = False
    Err.Raise Err.Number, _
              "clsSendIntIndex/InsertIntoInterfaceIndex", _
              Err.Description
            
Resume PROC_EXIT

End Function 'InsertIntoInterfaceIndex()
Public Function InsertIntoInterfaceXml(lngNewIntNo As String, strMsgId As String, strVersion As String, strDetail As String) As Boolean

'Db vars
Dim strSql As String
Dim adoConn As ADODB.Connection
Dim cmdAdo As ADODB.Command
Dim lngRecordsAffected As Long

Dim strCompleteXml As String
Dim xmldoc As MSXML2.DOMDocument
Dim strErrMsg As String


On Error GoTo PROC_ERROR

'strCompleteXml = strVersion & strDetail
strCompleteXml = strDetail

'check that file conforms with DTD
Set xmldoc = New MSXML2.DOMDocument

'Validation XML Document
'i.e. load the source XML file into an MSXML DOMDocument object
xmldoc.async = False
If Not xmldoc.loadXML(strCompleteXml) Then
    xmldoc.validateOnParse = True
    strErrMsg = strErrMsg & "Error Code:" & xmldoc.parseError.errorCode & vbCrLf
    strErrMsg = strErrMsg & "Error Reason:" & xmldoc.parseError.reason & vbCrLf
    strErrMsg = strErrMsg & "Error Text:" & xmldoc.parseError.srcText & vbCrLf
    strErrMsg = strErrMsg & "Error Line:" & xmldoc.parseError.Line & vbCrLf

    InsertIntoInterfaceXml = False
    Exit Function
End If

    strSql = "Insert into DIR_INTERFACE_XML"
    strSql = strSql & " ("
    strSql = strSql & " INTERFACE_NO,"
    strSql = strSql & " MESSAGE_ID,"
    strSql = strSql & " XML_STRING)"
    strSql = strSql & " Values("
    'get new no
    strSql = strSql & "'" & lngNewIntNo & "',"
    strSql = strSql & "'" & strMsgId & "',"
    strSql = strSql & "'" & strCompleteXml & "')"
   
    Set adoConn = New ADODB.Connection
    With adoConn
        .ConnectionString = GetConnectionString() 'Johann (20090625): Centralised code for connection string added
        .Open
    End With
   
   Set cmdAdo = New ADODB.Command
    With cmdAdo
        .CommandText = strSql
        .CommandType = adCmdText
        Set .ActiveConnection = adoConn
        .Execute lngRecordsAffected
    End With
    If lngRecordsAffected = 1 Then
        InsertIntoInterfaceXml = True
    Else
        InsertIntoInterfaceXml = False
    End If
    
'clean up
adoConn.Close
Set adoConn = Nothing
Set cmdAdo = Nothing
Set xmldoc = Nothing

PROC_EXIT:
  Exit Function

PROC_ERROR:
    InsertIntoInterfaceXml = False
    Err.Raise Err.Number, _
              "clsSendIntIndex/InsertIntoInterfaceXml", _
              Err.Description
            
Resume PROC_EXIT

End Function 'InsertIntoInterfaceXml()
Public Function UpdateInterfaceIndex(ByVal nReqSeqNum As String) As Boolean

'Db vars
Dim adoConn As ADODB.Connection
Dim strSql As String
Dim cmdAdo As ADODB.Command
Dim lngRecordsAffected As Long

Dim strCompleteXml As String
Dim xmldoc As MSXML2.DOMDocument
Dim strErrMsg As String


On Error GoTo PROC_ERROR

    
    'Update interface table - set status for received response from SARS to Y (Yes)
    strSql = "Update DIR_INTERFACE_index"
    strSql = strSql & " set sars_response_yn = 'Y'"
    strSql = strSql & " where req_seq_num = " & nReqSeqNum
    'strSql = strSql & " and sars_response_yn = 'N'" 'Johann(2009/07/27): removed

    Set adoConn = New ADODB.Connection
    With adoConn
        .CursorLocation = adUseClient
        .ConnectionString = GetConnectionString() 'Johann (20090625): Centralised code for connection string added
        .Open
    End With
   
    Set cmdAdo = New ADODB.Command
    With cmdAdo
        .CommandText = strSql
        .CommandType = adCmdText
        Set .ActiveConnection = adoConn
        .Execute lngRecordsAffected
    End With
        
    If lngRecordsAffected >= 1 Then
        UpdateInterfaceIndex = True
    Else
        UpdateInterfaceIndex = False
    End If
    
'clean up
adoConn.Close
Set adoConn = Nothing
Set cmdAdo = Nothing
Set xmldoc = Nothing

PROC_EXIT:
  Exit Function

PROC_ERROR:
    UpdateInterfaceIndex = False
    Err.Raise Err.Number, _
              "clsSendIntIndex/UpdateInterfaceIndex", _
              Err.Description
            
Resume PROC_EXIT

End Function 'UpdateInterfaceIndex()

